home *** CD-ROM | disk | FTP | other *** search
Text File | 1998-10-26 | 15.1 KB | 443 lines | [TEXT/ScoM] |
- ; Why is the player hacking that piano like that! Doesn't he know *rhythmics*?
- ; I know - but - hey! - it's just a program.
-
- (def-orchestra 'orchestra
- piano (lefthand righthand 3rd-voice)
- )
-
- (defun make-tr-melody (mel repeat trpat)
- (let ((out nil)
- (master-tr trpat)
- (trval nil))
- (dotimes (i (length trpat))
- (setq trval (car master-tr))
- (setq master-tr (cdr master-tr))
- (if (null master-tr) (setq master-tr trpat))
- (dotimes (j repeat)
- (push (symbol-transpose trval mel) out)))
- (flatten (nreverse out))))
-
- ; 14 7 good for piano
-
- (setq seedpat1 (vector-to-symbol a h (vector-quantize 7 8 (vector-resynthesize 3 (gen-noise-white 256 1 0.21215454) nil t))))
- (setq seedpat2 (symbol-inversion 'e seedpat1))
- (setq seedpat3 (vector-to-symbol a h (vector-quantize 7 8 (vector-resynthesize 3 (gen-noise-white 256 1 0.212115154) nil t))))
-
- (setq transpat (gen-random 0.2252 11 '(0 0 0 0 0 0 5 5 4 4 4)))
- (setq transpat2 (gen-random 0.322252 11 '(0 0 0 0 0 0 5 5 4 4 4)))
- (setq transpat3 (gen-random 0.252 11 '(0 0 0 0 0 0 5 5 4 4 4)))
-
- (setq melody-1 (symbol-fold 14 7 (make-tr-melody seedpat1 2 transpat)))
- (setq melody-2 (symbol-fold 14 7 (make-tr-melody seedpat2 2 transpat2)))
-
- (setq tempo-zone-len (/ (get-ratio '12/1 :ratio)
- (get-ratio '1/8 :ratio)))
-
- (setq tempomap1 (gen-fourier
- (gen-random 0.514123 5 '(1 2 3 5 8)) ; frequencies
- '(0.6 0.2 (gen-sin 10 0.22 64) 0.2) ; amplitudes
- '(0 45 90) ; initial phases
- tempo-zone-len))
-
- (setq tempomap2 (gen-fourier
- (gen-random 0.512412 5 '(1 2 3 5 8)) ; frequencies
- '(0.6 0.2 (gen-sin 10 0.22 64) 0.2) ; amplitudes
- '(0 45 90) ; initial phases
- tempo-zone-len))
- (def-section intro
- default ; 24 bars
- zone '(1/1 1/1 1/1 1/1 1/1 1/1 1/1 1/1
- 1/1 1/1 1/1 1/1 1/1 1/1 1/1 1/1
- 1/1 1/1 1/1 1/1 1/1 1/1 1/1 1/1)
- tempo-zones (symbol-repeat 24 '(1/1))
- tempo (vector-to-list (vector-round 96 103 (vector-quantize 12 24 (vector-mix tempomap1 tempomap2))))
- length '(1/16)
- velocity '(64)
- righthand
- tonality (symbol-repeat 2 (activate-tonality (melodic-minor c 5) (major d 5) (melodic-minor f 5)))
- symbol melody-1
- channel 1
- tuning (vector-to-list (vector-round -300 300 (gen-noise-white 128 1 0.39392)))
- duration (vector-to-list (vector-round (get-tick '1/9) (get-tick '1/30) tempomap1))
- velocity (vector-round 60 75 tempomap2)
- lefthand
- tonality (symbol-repeat 2 (activate-tonality (melodic-minor c 4) (major d 4) (melodic-minor f 4)))
- symbol melody-2
- channel 2
- tuning (vector-to-list (vector-round -300 300 (gen-noise-white 128 1 0.29392)))
- duration (vector-to-list (vector-round (get-tick '1/9) (get-tick '1/30) tempomap2))
- velocity (vector-round 60 75 tempomap2)
- 3rd-voice
- tonality (symbol-repeat 2 (activate-tonality (melodic-minor c 5) (major d 5) (melodic-minor f 4)))
- channel 5
- length '(1/16)
- symbol '(=)
- velocity '(0)
- duration (same-as length of 3rd-voice)
- tuning (vector-to-list (vector-round -300 300 (gen-noise-white 128 1 0.29392)))
- )
-
- #| This is a comment
- (midiport :printer)
-
- (play-file-p "prelude-b2"
- piano '(prelude prelude2)
- )
- |#
-
- ;;; part b
-
- (setq theme-source
- (make-tr-melody seedpat1 1 transpat3))
-
- (setq theme theme-source)
-
- (setq theme-enhansion
- (gen-expansion 1 '(a d c -c b)
- (symbol-retrograde
- (gen-loop '((8 1 1 4) (2 1 1 2))
- theme))))
-
- (init-soup 'bach-soup theme-enhansion)
-
- (setq variations
- (symbol-trim (* (length theme) 6)
- (gen-catalyze 'bach-soup 0.123425 30)))
-
- (setq melody-1-source
- (append theme
- (symbol-transpose 8
- (symbol-inversion 'a theme)) variations))
-
- (setq melody-2-source
- (symbol-transpose 11
- (symbol-shift 32
- (append theme
- (symbol-transpose 8
- (symbol-inversion 'a theme)) variations))))
-
- (setq harmonized-melodies
- (filter-harmonize2 melody-1-source melody-2-source 12
- (activate-tonality (harmonic-minor f 3))
- '((4 4))
- '((1 2 6 8 10 11))))
-
- (setq melody-1-mat (symbol-fold 14 7 (filter-deactivate 8 30 (find-change (car harmonized-melodies)))))
- (setq melody-2-mat (symbol-fold 14 7 (filter-deactivate 8 30 (find-change (cadr harmonized-melodies)))))
-
- (setq melody-1 melody-1-mat)
-
- (setq melody-2
- (symbol-remove
- (find-common melody-1-mat melody-2-mat)
- melody-2-mat))
-
- (def-section prelude
- default
- zone '(12/1)
- tempo-zones (symbol-trim tempo-zone-len '(1/8))
- tempo (vector-to-list (vector-round 70 90 tempomap1))
- tonality (activate-tonality (harmonic-minor f 3))
- lefthand
- channel 3
- symbol (symbol-melodize-skip melody-1)
- length (get-timing '1/16 melody-1)
- duration (change-length times 1.3 (same-as length of lefthand))
- velocity (symbol-to-velocity 65 110 3 (symbol-repeat 4 theme))
- tuning (vector-to-list (vector-round -300 300 (gen-noise-white 128 1 0.19392)))
- righthand
- channel 4
- symbol (symbol-shift 1 (symbol-melodize-skip melody-2))
- length (get-timing '1/16 melody-2)
- duration (change-length times 1.3 (same-as length of righthand))
- velocity (symbol-to-velocity 65 110 3 (reverse (symbol-repeat 4 theme)))
- tuning (vector-to-list (vector-round -300 300 (gen-noise-white 128 1 0.9392)))
- 3rd-voice
- tonality (symbol-repeat 2 (activate-tonality (melodic-minor c 5) (major d 5) (melodic-minor f 4)))
- channel 5
- length '(1/16)
- duration (same-as length of 3rd-voice)
- symbol '(=)
- velocity '(0)
- tuning (vector-to-list (vector-round -300 300 (gen-noise-white 128 1 0.29392)))
- )
-
- (setq theme-source
- (make-tr-melody seedpat2 1 transpat3))
-
- (setq theme theme-source)
-
- (setq theme-enhansion
- (gen-expansion 1 '(a d c -c b)
- (symbol-retrograde
- (gen-loop '((8 1 1 4) (2 1 1 2))
- theme))))
-
- (init-soup 'bach-soup theme-enhansion)
-
- (setq variations
- (symbol-trim (* (length theme) 6)
- (gen-catalyze 'bach-soup 0.123425 30)))
-
- (setq melody-1-source
- (append theme
- (symbol-transpose 8
- (symbol-inversion 'a theme)) variations))
-
- (setq melody-2-source
- (symbol-transpose 11
- (symbol-shift 32
- (append theme
- (symbol-transpose 8
- (symbol-inversion 'a theme)) variations))))
-
- (setq harmonized-melodies
- (filter-harmonize2 melody-1-source melody-2-source 12
- (activate-tonality (harmonic-minor f 3))
- '((4 4))
- '((1 2 6 8 10 11))))
-
- (setq melody-1 (filter-deactivate 8 30 (find-change (car harmonized-melodies))))
- (setq melody-2 (filter-deactivate 8 30 (find-change (cadr harmonized-melodies))))
-
- (def-section prelude2
- default
- zone '(12/1)
- tempo-zones (symbol-trim tempo-zone-len '(1/8))
- tempo (vector-to-list (vector-round 60 80 tempomap2))
- tonality (activate-tonality (harmonic-minor f 3))
- lefthand
- channel 3
- symbol (symbol-melodize-skip melody-1)
- length (get-timing '1/16 melody-1)
- velocity (symbol-to-velocity 65 110 3 (symbol-repeat 4 theme))
- tuning (vector-to-list (vector-round -300 300 (gen-noise-white 128 1 0.8392)))
- duration (change-length times 0.9 (same-as length of lefthand))
- righthand
- channel 4
- symbol (symbol-shift 1 (symbol-melodize-skip melody-2))
- length (get-timing '1/16 melody-2)
- velocity (symbol-to-velocity 65 110 3 (reverse (symbol-repeat 4 theme)))
- tuning (vector-to-list (vector-round -300 300 (gen-noise-white 128 1 0.7392)))
- duration (change-length times 0.9 (same-as length of righthand))
- 3rd-voice
- tonality (symbol-repeat 2 (activate-tonality (melodic-minor c 5) (major d 5) (melodic-minor f 4)))
- channel 5
- length '(1/16)
- symbol '(=)
- velocity '(0)
- tuning (vector-to-list (vector-round -300 300 (gen-noise-white 128 1 0.29392)))
- duration (same-as length of 3rd-voice)
- )
-
- #| This is a comment
- (play-file-p "prelude-b"
- piano '(prelude prelude2)
- )
- |#
-
- ;;; fugue
-
- (setq theme-source
- (append seedpat1
- seedpat3
- seedpat2
- (reverse seedpat3)))
-
- (setq theme theme-source)
-
- (setq theme-enhansion
- (gen-expansion 1 '(a d c -c b)
- (symbol-retrograde
- (gen-loop '((8 1 1 4) (2 1 1 2))
- theme))))
-
- (init-rnd 0.41123)
- (init-soup 'bach-soup theme-enhansion)
-
- (setq variations
- (symbol-trim (* (length theme) 6)
- (gen-catalyze 'bach-soup 0.1521412123425 30)))
-
- (setq melody-1-source
- (append theme
- (symbol-transpose 8
- (symbol-inversion 'a theme)) variations))
-
- (setq melody-2-source
- (symbol-transpose 11
- (symbol-shift (* 32 1 2)
- (append theme
- (symbol-transpose 8
- (symbol-inversion 'a theme)) variations))))
-
- (setq melody-3-source
- (symbol-transpose -5
- (symbol-shift (* 32 2 2)
- (append theme
- (symbol-transpose 8
- (symbol-inversion 'a theme)) variations))))
-
- (setq harmonized-melodies
- (filter-harmonize3
- melody-1-source melody-2-source melody-3-source 12
- (activate-tonality (harmonic-minor f 3))
- '((64 3) (32 3))
- '((1 2 6 8 10 11))
- '(0 5 7)))
-
- (setq melody-1 (symbol-fold 14 0 (filter-deactivate 16 69 (find-change (car harmonized-melodies)))))
- (setq melody-2 (symbol-fold 21 0 (filter-deactivate 16 69 (find-change (cadr harmonized-melodies)))))
- (setq melody-3 (symbol-fold 14 0 (filter-deactivate 16 69 (find-change (caddr harmonized-melodies)))))
-
- (def-section fugue
- default
- zone '(16/1)
- tempo-zones (symbol-trim tempo-zone-len '(1/8))
- tempo (vector-to-list (vector-round 73 78 tempomap2))
- tonality (activate-tonality (harmonic-minor f 3))
- lefthand
- channel 1
- length (get-timing '1/16 melody-1)
- symbol (symbol-melodize-skip melody-1)
- velocity (symbol-to-velocity 65 110 3 (symbol-repeat 4 theme))
- tuning (vector-to-list (vector-round -300 300 (gen-noise-white 128 1 0.6392)))
- duration (change-length times 1.1 (same-as length of lefthand))
- righthand
- channel 4
- length (get-timing '1/16 melody-2)
- symbol (symbol-shift 1 (symbol-melodize-skip melody-2))
- velocity (symbol-to-velocity 65 110 3 (reverse (symbol-repeat 4 theme)))
- tuning (vector-to-list (vector-round -300 300 (gen-noise-white 128 1 0.5392)))
- duration (change-length times 1.1 (same-as length of righthand))
- 3rd-voice
- channel 5
- tonality (activate-tonality (harmonic-minor f 4))
- length (get-timing '1/16 melody-3)
- symbol (symbol-shift 1 (symbol-melodize-skip melody-3)) ;; imitation with 2nd melody rhythm!!
- velocity (symbol-to-velocity 65 110 3 (reverse (symbol-repeat 4 theme)))
- tuning (vector-to-list (vector-round -300 300 (gen-noise-white 128 1 0.4392)))
- duration (change-length times 1.1 (same-as length of 3rd-voice))
- )
- #|
- (play-file-p "prelude-b"
- piano '(fugue)
- )
- |#
-
- ;;; fugue2
-
- (setq theme-source
- (gen-random-variate 0.3122841 0.5 2 2 (symbol-inversion 'g
- (append seedpat1
- seedpat3
- seedpat2
- (reverse seedpat3)))))
-
- (setq theme theme-source)
-
- (setq theme-enhansion
- (gen-expansion 1 '(a d c -c b)
- (symbol-retrograde
- (gen-loop '((8 1 1 4) (2 1 1 2))
- theme))))
-
- (init-rnd 0.21453)
- (init-soup 'bach-soup theme-enhansion)
-
- (setq variations
- (symbol-trim (* (length theme) 6)
- (gen-catalyze 'bach-soup 0.115214212123425 30)))
-
- (setq melody-1-source
- (append theme
- (symbol-transpose 8
- (symbol-inversion 'a theme)) variations))
-
- (setq melody-2-source
- (symbol-transpose 5
- (symbol-shift (* 32 1 2)
- (append theme
- (symbol-transpose 8
- (symbol-inversion 'a theme)) variations))))
-
- (setq melody-3-source
- (symbol-transpose -3
- (symbol-shift (* 32 2 2)
- (append theme
- (symbol-transpose 8
- (symbol-inversion 'a theme)) variations))))
-
- (setq harmonized-melodies
- (filter-harmonize3
- melody-1-source melody-2-source melody-3-source 12
- (activate-tonality (harmonic-minor f 3))
- '((64 3) (32 3))
- '((1 2 10 11))
- '(0 5 7)))
-
- (setq melody-1 (symbol-fold 14 7 (filter-deactivate 16 59 (find-change (car harmonized-melodies)))))
- (setq melody-2 (symbol-fold 21 0 (filter-deactivate 16 59 (find-change (cadr harmonized-melodies)))))
- (setq melody-3 (symbol-fold 14 7 (filter-deactivate 16 59 (find-change (caddr harmonized-melodies)))))
-
- (def-section fugue2
- default
- zone '(16/1)
- tonality (activate-tonality (harmonic-minor f 3))
- tempo-zones (symbol-trim tempo-zone-len '(1/8))
- tempo (vector-to-list (vector-round 70 77 tempomap2))
- lefthand
- channel 1
- length (get-timing '1/16 melody-1)
- symbol (symbol-melodize-skip melody-1)
- velocity (symbol-to-velocity 65 110 3 (symbol-repeat 4 theme))
- tuning (vector-to-list (vector-round -300 300 (gen-noise-white 128 1 0.3392)))
- duration (same-as length of lefthand)
- righthand
- channel 4
- length (get-timing '1/16 melody-2)
- symbol (symbol-shift 1 (symbol-melodize-skip melody-2))
- velocity (symbol-to-velocity 65 110 3 (reverse (symbol-repeat 4 theme)))
- tuning (vector-to-list (vector-round -300 300 (gen-noise-white 128 1 0.2392)))
- duration (same-as length of righthand)
- 3rd-voice
- channel 5
- tonality (activate-tonality (harmonic-minor f 4))
- length (get-timing '1/16 melody-3)
- symbol (symbol-shift 1 (symbol-melodize-skip melody-3)) ;; imitation with 2nd melody rhythm!!
- velocity (symbol-to-velocity 65 110 3 (reverse (symbol-repeat 4 theme)))
- tuning (vector-to-list (vector-round -300 300 (gen-noise-white 128 1 0.1392)))
- duration (same-as length of 3rd-voice)
- )
-
- (def-section cadenze
- default
- zone '(2/1 1/1)
- tonality (activate-tonality (major f 3))
- length '((1/8) (1/1))
- velocity '(84)
- tuning '(0)
- duration as-length
- tempo-zones '(2/1 1/1)
- tempo '(80 80)
- lefthand
- channel 1
- symbol (list (symbol-mix '(p = n n o = = = o = = o n = = n l)
- '(r (-1 t) s r s r (-1 q) p (-1 q) = = r p = = o))
- '(ol))
- righthand
- channel 2
- symbol (list (symbol-mix '(g = k k (-1 j) = (-1 m) = l = = l = = k k j)
- '(b = i i (-1 j) = k = l = k k l = e e a))
- '(ja))
- 3rd-voice
- channel 3
- symbol '(=)
- )
-
- (midiport :printer)
-
- (play-file-p "prelude&fugue#4.mid"
- piano '(intro prelude prelude2 fugue fugue2 cadenze)
- )
-